home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Collections: Taifun
/
Taifun 143 (1990-08-15)(Ossowski, Stefan)(DE)(PD).zip
/
Taifun 143 (1990-08-15)(Ossowski, Stefan)(DE)(PD).adf
/
SASTools
/
UFO
/
UFO.mod
< prev
next >
Wrap
Text File
|
1990-05-16
|
4KB
|
95 lines
(***************************************************************************
* Programme : UFO.mod *
* Usage : UFO *
* Version : V1.20 *
* Date : 27.-30.11.1989 *
* Author : Jörg Sixt *
* Purpose : a useful tool to damage useless screens *
* Language : Modula-2,AMSoft PD-Version from Fish 113 *
* Bugs : does not use input.device *
***************************************************************************)
MODULE UFO ;
FROM SYSTEM IMPORT ADR,ADDRESS,INLINE ;
FROM Graphics IMPORT SimpleSprite,GetSprite,MoveSprite,FreeSprite,ViewModes,
ViewModeSet,RastPortPtr,ViewPortPtr,ReadPixel,SetAPen,
Move,Draw ;
FROM Intuition IMPORT IntuitionBase,OpenIntuition,ScreenPtr ;
FROM Exec IMPORT AllocMem,FreeMem,MemReqs,MemReqSet,CopyMem ;
FROM Arts IMPORT TermProcedure,Terminate ;
FROM Dos IMPORT Delay ;
VAR MemPtr : ADDRESS ;
ScrPtr : ScreenPtr ;
Raster : RastPortPtr ;
Viewer : ViewPortPtr ;
IBase : POINTER TO IntuitionBase ;
SimSprite : SimpleSprite ;
NumSprite,
xs,ys,xf,yf,i,
minx,miny : INTEGER ;
CIAA [12577793] : CHAR ;
PROCEDURE SpriteData ;
BEGIN
INLINE( 00000H,00000H, 00180H,00180H, 003C0H,00180H,
007E0H, 00240H, 00FF0H, 003C0H,
01FF8H, 00420H, 03FFCH, 00420H,
07FFEH,00810H, 0FFFFH,0FFFFH,0FFFFH, 01008H,07FFEH,
01008H, 03FFCH, 00000H, 027E4H,
007E0H, 02004H, 00000H, 0700EH,
00000H,00000H, 0700EH, 00000H, 02004H,00000H,
00000H) ;
END SpriteData ;
PROCEDURE Quit ;
BEGIN
IF (MemPtr # NIL) THEN FreeMem(MemPtr,72) ; END ;
IF (NumSprite # -1) THEN FreeSprite(NumSprite) ; END ;
END Quit ;
BEGIN (* MAIN PROGRAM *)
NumSprite := -1 ;
TermProcedure(Quit) ;
MemPtr := AllocMem(72,MemReqSet{memClear,public,chip}) ;
IF (MemPtr = NIL) THEN HALT ; END ;
CopyMem(ADR(SpriteData),MemPtr,72) ;
WITH SimSprite DO
posctldata := MemPtr ;
height := 16 ;
END ;
NumSprite := GetSprite(ADR(SimSprite),-1) ;
IF (NumSprite = -1) THEN HALT ; END ;
IBase := OpenIntuition() ;
LOOP
Delay(1) ;
ScrPtr := IBase^.activeScreen ;
Raster := ADR(ScrPtr^.rastPort) ;
Viewer := ADR(ScrPtr^.viewPort) ;
IF (hires IN Viewer^.modes) THEN xf := xs+16 ; minx := -29 ;
ELSE xf := xs+8 ; minx := -14 ; END ;
IF (lace IN Viewer^.modes) THEN yf := ys-2 ; miny := -29 ;
ELSE yf := ys-1 ; miny := -14 ; END ;
CASE ORD(CIAA) OF
|067H : DEC(ys) ;
|065H : INC(ys) ;
|061H : DEC(xs) ;
|063H : INC(xs) ;
|075H : Terminate(0) ;
|07FH : i := yf ;
WHILE (ReadPixel(Raster,xf,i) = 0) DO DEC(i) ; END ;
SetAPen(Raster,1) ; Move(Raster,xf,yf) ; Draw(Raster,xf,i) ;
Delay(9);
SetAPen(Raster,0) ; Move(Raster,xf,yf) ; Draw(Raster,xf,i) ;
ELSE
END ;
IF (xs>ScrPtr^.width-2) THEN xs := minx ; END ;
IF (xs<minx) THEN xs := ScrPtr^.width-2 ; END ;
IF (ys>ScrPtr^.height-2) THEN ys := miny ; END ;
IF (ys<miny) THEN ys := ScrPtr^.height-2 ; END ;
MoveSprite(Viewer,ADR(SimSprite),xs,ys) ;
END ;
END UFO.